home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 3
/
Cream of the Crop 3.iso
/
diag
/
itcom1.zip
/
COMPARE.EXE
/
IT
/
DEMO
/
TEST1.CLA
< prev
next >
Wrap
Text File
|
1993-10-08
|
11KB
|
279 lines
TITLE('Tester')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Program - Tester ! ║
║ Author - John Doe ! ║
╚════════════════════════════════════════════════════════════════════════════╝
PROGRAM
INCLUDE('KEYCODES.EQU')
INCLUDE('CLARION.EQU')
INCLUDE('ERRORS.EQU')
MAP
CheckOpen(*FILE)
DiskError(<STRING>),BYTE
ShowWarning
MODULE('ITCOMP01')
Procedure11
Procedure12
Procedure13
END
MODULE('ITCOMP02')
Procedure21
Procedure22
Procedure23
END
MODULE('ITCOMP03')
Procedure31
Function32(STRING,QUEUE,BYTE),SHORT
Procedure33
Procedure34
END
MODULE('ITCOMP04')
Function41(FILE,FILE),SHORT
Function42(FILE,FILE),SHORT
END
INCLUDE('C:\CLARION3\INCLUDE.INC')
INCLUDE('GETDIR.INC')
EMBED('~~::PROGRAM~1~MAP Structure~1~~')
INCLUDE('TEMPFILE.INC')
ENDEMBED
END
EJECT('File Layouts')
GLO:MessageGroup GROUP
GLO:Message1 STRING(45)
GLO:Message2 STRING(45)
GLO:Message3 STRING(45)
.
GLO:InsertMsg STRING('Record will be added {9}')
GLO:ChangeMsg STRING('Record will be changed {7}')
GLO:DeleteMsg STRING('Select OK to delete {10}')
GLO:Filespec STRING(64)
dF:Variable1 STRING(64)
dF:Variable2 STRING(64)
dF:Variable3 STRING(64)
df:Variable4 STRING(64)
dF:Variable5 STRING(64)
dF:Variable6 STRING(64)
dF:Variable7 STRING(64)
ExitChain SHORT
GLO:EnablePrint BYTE
! ███████████████████████████████████████████████████████████████████
! TEST1.CLA
! ███████████████████████████████████████████████████████████████████
FileIn FILE,PRE(In),DRIVER('Ascii'),NAME(dF:AsciiIn)!<<DRIVER
RECORD RECORD !<<STRUCT
sLine STRING(255)
. .
include('TESTINC.INC') !<<<INCLUDE has FILE SPEC not in TEST2.CLA
File1 FILE,PRE(Fi1),DRIVER('Btrieve'),NAME(dF:Variable1) !<<PRE
I_Dyna1 INDEX(),NAME('sams.idx') !<<<NAME
I_Dyna2 INDEX(+Fi1:Field1,-Fi1:Field2),OPT !<<NOCASE
K_Dummy KEY(+Fi1:Field1,-Fi1:Field2,-Fi1:Field3),DUP!<<Order 2nd
testrecord RECORD
Field1 STRING(64)
Field2 STRING(16) !<<STRING(8)
Field3 LONG
Field4 STRING(8)
Field5 STRING(32)
Field6 STRING(12)
!Field7 BYTE !<<Commented
Field8 BYTE
Field9 BYTE
Field10 STRING(64)
Field11 STRING(3)
. .
File2 FILE,PRE(Fi2),DRIVER('Clarion'),CREATE,NAME(dF:Variable2)!─┐
I_Dyna1 INDEX(),NOCASE !<<No CREATE, No Name ─────────┘
I_Dyna2 INDEX(),NOCASE
RECORD RECORD
Field1 STRING(32) !<<STRING(16)
Field2 STRING(16)
Field3 LONG
Field4 STRING(8)
Field5 STRING(16)
Field6 STRING(12) !<<Commented
Field7 BYTE
Field8 BYTE
Field9 BYTE
Field10 STRING(64)
Field11 STRING(3)
. .
! <<<<<<<<<<<<< Omitted File3
File4 FILE,PRE(Fi4),DRIVER('Btrieve'),CREATE !<<DRIVER, no NAME
I_Dyna1 INDEX(),NOCASE
I_Dyna2 INDEX(),NOCASE
RECORD RECORD
Field41 LONG
Field42 LONG
Field43 LONG
Field44 STRING(16)
Field45 STRING(20)
Group41 Group,Pre(G41) !<<PRE
GrField41 STRING(4)
GrField42 LONG !<<LONG
. . .
File5 FILE,PRE(Fi5),DRIVER('Clarion'),CREATE,NAME(dF:Variable5)
I_Dyna1 INDEX(),NOCASE
I_Dyna2 INDEX(),NOCASE
RECORD RECORD
Field51 LONG
Field52 LONG
Field53 LONG
Field54 STRING(16)
Field55 STRING(16)
Field56 SHORT
Field57 STRING(16)
Field58 BYTE
. . !No GROUP Group59
File6 FILE,PRE(Fi6),DRIVER('Clarion'),CREATE,NAME(dF:Variable6)!─┐
I_Dyna1 INDEX(),NOCASE !<<< NO File 6 ────────────┘
I_Dyna2 INDEX(),NOCASE
RECORD RECORD
Field61 LONG
Field62 LONG
Field63 STRING(16)
Field64 STRING(16)
Field65 BYTE
Field66 BYTE
Field67 BYTE
Field68 STRING(64)
. .
AddRecord EQUATE(1) ! Add a new record
ChangeRecord EQUATE(2) ! Change the current record
DeleteRecord EQUATE(3) ! Delete the current record
EMBED('~~::PROGRAM~1~Data Section~1~~')
Queue Queue,Pre(Qst)
QPtr BYTE
QValue STRING(32)
.
n LONG
nFormat STRING(5)
Temp CSTRING(65)
TmpFile CSTRING(65)
ENDEMBED
CODE
Procedure1
RETURN !Return to DOS
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after opening a file ║
╚════════════════════════════════════════════════════════════════════════════╝
CheckOpen PROCEDURE(File)
CODE
OPEN(File,22h) !Attempt to open the file
CASE ERRORCODE() ! and check for errors
OF NoError !Return if no error
OROF IsOpenErr ! or if already open.
RETURN
OF NoFileErr !If file was not found
CREATE(File) !Create the file
OPEN(File,22h) ! then open it
IF ~ERRORCODE() THEN RETURN. ! And return if it opened
OF InvalidFileErr !Invalid Record Declaration
GLO:Message1 = 'Error accessing: '& NAME(File)
GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(InvalidFileErr)
OF BadKeyErr !Key Files must be rebuilt
GLO:Message1 = NAME(File) & ' Key file is invalid'
GLO:Message3 = 'Press OK to rebuild keyfile'
ShowWarning
OPEN(File,12H) !Open for exclusive access
BUILD(File) !Rebuild the key files
IF ERRORCODE()
GLO:Message1 = NAME(File) & ' The file cannot be repaired'
GLO:Message2 = 'while other stations are using it'
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(BadKeyErr)
ELSE
CLOSE(File) !Close
OPEN(File,22h) ! then open it
END
END !End of Case Structure
IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). !Cannot resume
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after a disk access ║
╚════════════════════════════════════════════════════════════════════════════╝
DiskError FUNCTION(Cause)
StopMsg:: STRING(180)
CODE
IF ~ERRORCODE() THEN RETURN(0). !Return with no error
IF ~OMITTED(1) !If a cause was given
StopMsg:: = 'Cause: ' & Cause & LF:CR ! Display it
END !End IF
IF ERRORFILE() !If error involves a file
StopMsg:: = CLIP(StopMsg::) & 'File : ' | ! display the file
& ERRORFILE() & LF:CR
END !End IF
StopMsg:: = CLIP(StopMsg::) & 'Error: ' | !Display the error code
& ERRORCODE() & ' - ' | ! and the error message
& ERROR() & LF:CR
STOP(StopMsg::) !Stop with message
RETURN(1) !Return with error
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Display a warning message using 3 Global message variables. ║
╚════════════════════════════════════════════════════════════════════════════╝
ShowWarning PROCEDURE
SaveStyle STRING(256)
Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
ROW(1,1) STRING('█▀{51}█'),COLOR(116)
ROW(9,1) STRING('█▄{51}█'),COLOR(116)
REPEAT(7)
ROW(2,1) STRING('█'),COLOR(116)
ROW(2,53) STRING('█'),COLOR(116)
.
ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
ROW(7,24) BUTTON(' &Ok |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
.
CODE
SaveStyle = STYLES() !Save current style
GETSTYLES('') !Turn off Styles
GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
OPEN(Screen)
DISPLAY
ACCEPT !Enable keyboard and mouse
CLEAR(GLO:MessageGroup) !Blank out message fields
SETSTYLES(SaveStyle) !Restore user styles
RETURN